unit uunziper;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, unzip, regexpr;
type
  Tunziper = class

    function loadfile(filename: string): Boolean;
    function extract(patch: string): boolean;
    function get_extracted_file_list: TStringList;
    constructor create;
    destructor destroy;

  private
    exporter: TRegExpr;

    list_of_file: TStringList;
    UFuncs: USERFUNCTIONS;
    DCList: DCL;
    procedure msgcallback(x: string);
  end;

procedure CallbackMessage(ucsize, csiz, cfactor, mo, dy, yr, hh, mm: Longword; c: Byte; fname, meth: PChar; crc: Longword; fCrypt: Byte); stdcall;
function CallbackPassword(pwbuf: PChar; size: Longint; m, efn: PChar): EDllPassword; stdcall;
function CallbackPrint(buffer: PChar; size: Longword): EDllPrint; stdcall;
function CallbackReplace(filename: PChar): EDllReplace; stdcall;
function CallbackService(efn: PChar; details: Longword): EDllService; stdcall;

implementation

var
  callback_global: procedure(x: string) of object;

destructor Tunziper.destroy;
begin

  exporter.Destroy;
  list_of_file.Destroy;
end;

function Tunziper.get_extracted_file_list: TStringList;
begin
  Result := list_of_file;
end;

constructor Tunziper.create;
begin
  callback_global := msgcallback;

  exporter := TRegExpr.Create;
  list_of_file := TStringList.Create;

end;

procedure Tunziper.msgcallback(x: string);
var
  i: Integer;
  temp: string;
begin

  exporter.Expression := 'inflating:\s+(.*)\s+';
  for i := 0 to Length(x)  do
    if x[i] = '/' then x[i] := '\';

  if exporter.Exec(x) then
  begin
    temp := exporter.Match[1];
    for i := Length(temp)  downto 0 do
    begin
      if (temp[i] = ' ') then temp:=copy(temp,0,i-1) else
      break; end;

    list_of_file.Add(temp)
  end;
end;


function Tunziper.extract(patch: string): Boolean;
var
  incl: array of PChar;
  excl: array of PChar;

begin
  DCList.lpszExtractDir := pchar(patch);

  if Wiz_SingleEntryUnzip(2, incl[0], 2, excl[0], Dclist, UFuncs) = PK_OK then
    Result := true else result := False;
end;

function Tunziper.loadfile(filename: string): boolean;
begin
  with UFuncs do
  begin
    print := CallbackPrint;
    sound := nil;
    replace := CallbackReplace;
    password := CallbackPassword;
    SendApplicationMessage := CallbackMessage;
    ServCallBk := CallbackService;
  end;
  with DCList do
  begin
    ExtractOnlyNewer := 0;
    SpaceToUnderscore := 0;
    PromptToOverwrite := 1;
    fQuiet := 0;
    ncflag := 0;
    ntflag := 0;
    nvflag := 0;
    nfflag := 0;
    nzflag := 0;
    ndflag := 1;
    noflag := 1;
    naflag := 0;
    nZIflag := 0;
    C_flag := 1;
    fPrivilege := 0;
    lpszZipFN := pchar(filename);
  end;
  if FileExists(filename) then Result := true else result := False;
end;


procedure CallbackMessage(ucsize, csiz, cfactor, mo, dy, yr, hh, mm: Longword; c: Byte; fname, meth: PChar; crc: Longword; fCrypt: Byte);
var
  temp: string;
begin
end;


function CallbackPassword(pwbuf: PChar; size: Longint; m, efn: PChar): EDllPassword;
begin Result := IZ_PW_NONE; end;


function CallbackPrint(buffer: PChar; size: Longword): EDllPrint;
begin
  //Form1.Memo1.Lines.Add('unzip32 Print: ' + buffer);
  callback_global('unzip32 Print: ' + buffer);
  Result := size;
end;


function CallbackReplace(filename: PChar): EDllReplace;
begin Result := IDM_REPLACE_NONE; end;


function CallbackService(efn: PChar; details: Longword): EDllService;
begin Result := UZ_ST_CONTINUE; end;



end.

